PLOTLY package

library(plotly)
## Loading required package: ggplot2
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout

Basic 3D Surface Plot

fig <- plot_ly(z = ~volcano)
fig <- fig %>% add_surface()
fig

2D Kernel Density Estimation

kd <- with(MASS::geyser, MASS::kde2d(duration, waiting, n = 50))
fig <- plot_ly(x = kd$x, y = kd$y, z = kd$z) %>% add_surface()
fig

RGL package

library(rgl)
data(iris)
head(iris)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa
x <- sep.l <- iris$Sepal.Length
y <- pet.l <- iris$Petal.Length
z <- sep.w <- iris$Sepal.Width
rgl.open()

Scatter plots

rgl.points(x, y, z, color ="lightgray")
rgl.open()
rgl.bg(color = "white") 
rgl.points(x, y, z, color = "pink", size = 5)

Draw spheres

rgl.open()
rgl.bg(color = "white") 
rgl.spheres(x, y, z, r = 0.2, color = "grey")

Add boxes

rgl.open()
rgl.bg(color = "white") 
rgl.spheres(x, y, z, r = 0.2, color = "white")  
rgl.bbox(color=c("#333377","black"), emission="#333377",
         specular="#3333FF", shininess=5, alpha=0.8 )

CAR package

library(car)
## Loading required package: carData

3D plot with the regression plane

scatter3d(x = sep.l, y = pet.l, z = sep.w)
## Loading required namespace: mgcv

Points by groups

scatter3d(x = sep.l, y = pet.l, z = sep.w, groups = iris$Species)

Add concentration ellipsoids

scatter3d(x = sep.l, y = pet.l, z = sep.w, groups = iris$Species,
          surface=FALSE, grid = FALSE, ellipsoid = TRUE)

Add text labels for the points

scatter3d(x = sep.l, y = pet.l, z = sep.w, 
          surface=FALSE, labels = rownames(iris), id.n=nrow(iris))

Save images

rgl.snapshot(filename = "plot.png")
rgl.postscript("plot.pdf",fmt="pdf")

plot3D package

library(plot3D)

Scatter plots

scatter3D(x, y, z, bty = "g", colkey = FALSE, main ="bty= 'g'")

scatter3D(x, y, z, pch = 18, bty = "u", colkey = FALSE, 
   main ="bty= 'u'", col.panel ="steelblue", expand =0.4, 
   col.grid = "darkblue")

3D Histogram

data(VADeaths)
#  hist3D and ribbon3D with greyish background, rotated, rescaled,...
hist3D(z = VADeaths, scale = FALSE, expand = 0.01, bty = "g", phi = 20,
        col = "thistle", border = "white", shade = 0.2, ltheta = 90,
        space = 0.3, ticktype = "detailed", d = 2)

Add interactivity

library("plot3Drgl")
plotrgl()

Explore other options

library(rayshader)
library(ggplot2)
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────────── tidyverse 1.2.1 ──
## ✔ tibble  2.1.1     ✔ purrr   0.3.2
## ✔ tidyr   1.0.2     ✔ dplyr   0.8.3
## ✔ readr   1.3.1     ✔ stringr 1.4.0
## ✔ tibble  2.1.1     ✔ forcats 0.4.0
## ── Conflicts ────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks plotly::filter(), stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some()   masks car::some()

3D Surface Plots

rgl.open()
gg = ggplot(diamonds, aes(x, depth)) +
  stat_density_2d(aes(fill = stat(nlevel)), 
                  geom = "polygon",
                  n = 100,bins = 10,contour = TRUE) +
  facet_wrap(clarity~.) +
  scale_fill_viridis_c(option = "A")
plot_gg(gg,multicore=TRUE,width=5,height=5,scale=250)
## Warning in make_shadow(heightmap, shadowdepth, shadowwidth, background, :
## `magick` package required for smooth shadow--using basic shadow instead.

3D maps

library(sf)
## Linking to GEOS 3.7.2, GDAL 2.4.2, PROJ 5.2.0
library(viridis)
## Loading required package: viridisLite
rgl.open()
nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE)
gg_nc = ggplot(nc) +
  geom_sf(aes(fill = AREA)) +
  scale_fill_viridis("Area") +
  ggtitle("Area of counties in North Carolina") +
  theme_bw()

plot_gg(gg_nc, multicore = TRUE, width = 6 ,height=2.7, fov = 70)
## Warning in make_shadow(heightmap, shadowdepth, shadowwidth, background, :
## `magick` package required for smooth shadow--using basic shadow instead.
render_depth(focallength=100,focus=0.72)

And many other options

For more details: https://www.tylermw.com/3d-ggplots-with-rayshader/

rgl.open()
a = data.frame(x=rnorm(20000, 10, 1.9), y=rnorm(20000, 10, 1.2) )
b = data.frame(x=rnorm(20000, 14.5, 1.9), y=rnorm(20000, 14.5, 1.9) )
c = data.frame(x=rnorm(20000, 9.5, 1.9), y=rnorm(20000, 15.5, 1.9) )
data = rbind(a,b,c)

#Lines
pp = ggplot(data, aes(x=x, y=y)) +
  geom_hex(bins = 20, size = 0.5, color = "black") +
  scale_fill_viridis_c(option = "C")
plot_gg(pp, width = 4, height = 4, scale = 300, multicore = TRUE)
## Warning in make_shadow(heightmap, shadowdepth, shadowwidth, background, :
## `magick` package required for smooth shadow--using basic shadow instead.
#No lines
pp_nolines = ggplot(data, aes(x=x, y=y)) +
  geom_hex(bins = 20, size = 0) +
  scale_fill_viridis_c(option = "C")
plot_gg(pp_nolines, width = 4, height = 4, scale = 300, multicore = TRUE)
## Warning in make_shadow(heightmap, shadowdepth, shadowwidth, background, :
## `magick` package required for smooth shadow--using basic shadow instead.
rgl.open()
mtcars_gg = ggplot(mtcars) + 
  geom_point(aes(x=mpg,color=cyl,y=disp),size=2) +
  scale_color_continuous(limits=c(0,8)) +
  ggtitle("mtcars: Displacement vs mpg vs # of cylinders") +
  theme(title = element_text(size=8),
        text = element_text(size=12)) 

plot_gg(mtcars_gg, height=3, width=3.5, multicore=TRUE, pointcontract = 0.7, soliddepth=-200)
## Warning in make_shadow(heightmap, shadowdepth, shadowwidth, background, :
## `magick` package required for smooth shadow--using basic shadow instead.
library(tidyverse)
rgl.open()
measles = read_csv("https://tylermw.com/data/measles_country_2011_2019.csv")
## Parsed with column specification:
## cols(
##   Region = col_character(),
##   ISO3 = col_character(),
##   Country = col_character(),
##   Year = col_double(),
##   January = col_double(),
##   February = col_double(),
##   March = col_double(),
##   April = col_double(),
##   May = col_double(),
##   June = col_double(),
##   July = col_double(),
##   August = col_double(),
##   September = col_double(),
##   October = col_double(),
##   November = col_double(),
##   December = col_double()
## )
melt_measles = reshape2::melt(measles, id.vars = c("Year", "Country", "Region", "ISO3"))
melt_measles$Month = melt_measles$variable
melt_measles$cases = melt_measles$value
melt_measles %>% 
  group_by(Year, Month) %>%
  summarize(totalcases = sum(cases,na.rm = TRUE)) %>% 
  mutate(totalcases = ifelse(Year == 2019 & !(Month %in% c("January","February","March")), NA, totalcases)) %>%
  ggplot() + 
  geom_tile(aes(x=Year, y=Month, fill=totalcases,color=totalcases),size=1,color="black") + 
  scale_x_continuous("Year", expand=c(0,0), breaks = seq(2011,2019,1)) +
  scale_y_discrete("Month", expand=c(0,0)) +
  scale_fill_viridis("Total\nCases") +
  ggtitle("Reported Worldwide Measles Cases") +
  labs(caption = "Data Source: WHO") +
  theme(axis.text = element_text(size = 12),
        title = element_text(size = 12,face="bold"),
        panel.border= element_rect(size=2,color="black",fill=NA)) -> 
measles_gg

plot_gg(measles_gg, multicore = TRUE, width = 6, height = 5.5, scale = 300,shadowcolor = "#3a4f70")
## Warning in make_shadow(heightmap, shadowdepth, shadowwidth, background, :
## `magick` package required for smooth shadow--using basic shadow instead.